home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Games of Daze
/
Infomagic - Games of Daze (Summer 1995) (Disc 1 of 2).iso
/
x2ftp
/
msdos
/
source
/
demostuf
/
zlogo1.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1994-07-25
|
3KB
|
213 lines
program logo1;
{
Zoom Logo #1
- by Bjarke Viksφe
mar 1994
THIS PROGRAM WAS CODED BY BJARKE VIKS0E.
YOU ARE FREE TO DO WHATEVER YOU WANT WITH THIS PIECE OF CODE.
E-MAIL ME AT: dat92230@rix02.lyngbyes.dk IN 1994 FOR CHAT AND CODE.
Zooming is pretty easy. Zoom positions are precalc'ed, some may complain
about this - array look-ups takes longer time the real-time calc'ing.
Uses my generic 'calc middle-values' routine which has proved pretty
handy. Called calc-slope.
}
(*{$DEFINE DEBUG}*)
uses
DEMOINIT,ILBM256;
type
SlopeArray = array[0..320] of integer;
var
buffer,tempscreen : pScreen;
slope : SlopeArray;
otherslope : SlopeArray;
y320tabel : array[0..HEIGHT] of word;
xpos,ypos,xsize,ysize : integer;
const
display1 : integer = $0000;
display2 : integer = $4000;
(*------------------------------------------------*)
procedure InitDemo;
var
i : integer;
begin
Screen_Off;
FadeCMAP(0);
ClearWholeScreen;
xsize:=120;
ysize:=2;
xpos:=160-(xsize DIV 2);
ypos:=100-(ysize DIV 2);
for i:=0 to HEIGHT do y320tabel[i]:=i*320;
new(buffer);
new(tempscreen);
LoadPix(buffer,'PARASIT1.LBM');
MakeTweak(buffer,tempscreen);
SetCMAP;
Screen_On;
end;
procedure UninitDemo;
var
i : integer;
begin
dispose(buffer);
dispose(tempscreen);
end;
(*------------------------------------------------*)
procedure SwapDisplay;
var
temp : word;
begin
temp:=display2;
display2:=display1;
display1:=temp;
SetAddress(Ptr(SEGA000,display2));
end;
(*------------------------------------------------*)
procedure CalcSlope(x1,x2,ysize : integer); assembler;
asm
lea si,slope
mov ax,x1
mov cx,x2
mov dx,ysize
push ax
sub cx,ax
inc cx
and dx,dx
jz @zero
cmp dx,1
jne @not1
dec cx
mov dx,cx
xor ax,ax
jmp @one
@not1:
cmp dx,2
jne @not2
mov ax,$7FFF
imul cx
jmp @one
@not2:
mov dx,$0001
mov ax,$0000
idiv ysize
imul cx
@one:
pop cx
xor bx,bx
inc ysize
@loop:
mov [si],cx
add si,2
add bx,ax
adc cx,dx
dec ysize
jnz @loop
@zero:
end;
(*------------------------------------------------*)
procedure ZoomLine(xpos,ysize,dst_offset : word); assembler;
asm
push ds
mov es,SEGA000
mov di,dst_offset
add di,display1
mov ax,WORD PTR buffer+2
DB $8E,$E0 {mov fs,ax}
mov dx,xpos
add dx,WORD PTR buffer
lea si,slope
mov cx,ysize
cld
@yloop:
lodsw
add ax,dx
mov bx,ax
DB $64 {FS: prefix}
mov al,[bx]
mov [es:di],al
add di,WIDTH
loop @yloop
pop ds
end;
(*------------------------------------------------*)
procedure RunOnce;
var
i,j : integer;
dst_offset : word;
begin
SwapDisplay;
VBLANK;
{$IFDEF DEBUG}
SetRGB(0,30,0,0);
{$ENDIF}
CalcSlope(0,319,xsize);
otherslope:=slope;
CalcSlope(0,199,ysize);
for i:=0 to ysize do slope[i]:=y320tabel[slope[i]];
j:=0;
dst_offset:=(ypos*WIDTH)+(xpos shr 2);
for i:=xpos to xpos+xsize do begin
SetBitplanes(1 shl (i AND 3));
ZoomLine(otherslope[j],ysize,dst_offset);
inc(j);
if ((i AND 3)=3) then inc(dst_offset);
end;
if (xpos>0) AND (ypos>0) then begin
dec(xpos);
dec(ypos);
inc(xsize,2);
inc(ysize,2);
end;
{$IFDEF DEBUG}
SetRGB(0,0,0,0);
{$ENDIF}
end;
begin
OpenScreen;
InitDemo;
repeat RunOnce until KeyPressed;
UninitDemo;
CloseScreen;
writeln;
writeln('A small piece of code by Bjarke Viksφe...');
end.